;;;The list  v used by SORT1C is of the form (v0 v1 ,,, vn) 
;;;    where n=floor[log2[pass]] where pass=number of elements of the
;;;    original u that have been sorted onto v.  
;;;    each element of v is a sorted sublist of u and |vi| is 0 or 2↑i.
;;;If we sort the list (1 2 3 4 5 6 7 8) the successive arguments to SORT1A are:
;;;(1 2 3 4 5 6 7 8),NIL
;;;(2 3 4 5 6 7 8),((1))
;;;(3 4 5 6 7 8),(NIL (1 2))
;;;(4 5 6 7 8),((3) (1 2))
;;;(5 6 7 8),(NIL NIL (1 2 3 4))
;;;(6 7 8),((5) NIL (1 2 3 4))
;;;(7 8),((NIL (5  6) (1 2 3 4))
;;;(8),(((7) (5  6) (1 2 3 4))
;;;NIL,(NIL NIL NIL (1 2 3 4 5 6 7 8))
;;;
;;;SORT1C does a final merge of all the sorted sublists

(DEFUN SORT1 (U) (SORT1A U NIL))

(DEFUN SORT1A (U V) 
  (COND ((NULL U) (SORT1C NIL V))
	(T (SORT1A (CDR U) (SORT1B (LIST (CAR U)) V)))))

(DEFUN SORT1B (U V) 
  (COND ((NULL V) (LIST U))
	((NULL (CAR V)) (CONS U (CDR V)))
	(T (CONS NIL (SORT1B (MERGE U (CAR V)) (CDR V))))))

(DEFUN SORT1C (U V) 
  (COND ((NULL V) U)
	(T (SORT1C (MERGE U (CAR V)) (CDR V)))))



;;;SORT2 works by first making a list of 1 element lists the making successive
;;;    passes over the list of sorted sublists merging alternate pairs
;;;    until only one list remains.

(DEFUN SORT2 (U) (SORT2A (MAPCAR '(LAMBDA (X) (LIST X)) U)))

(DEFUN SORT2A (U) 
  (cond ((null u) nil) 
	((null (cdr u)) (car u))
	(T (SORT2A (SORT2B U)))))

(DEFUN SORT2B (U) 
  (COND ((OR (NULL U) (NULL (CDR U))) U)
	(T (CONS (MERGE (CAR U) (CADR U)) (SORT2B (CDDR U))))))


(DEFUN MERGE (U V) 
  (COND ((NULL U) V) 
	((NULL V) U)
	((LESSP (CAR U) (CAR V)) (CONS (CAR U) (MERGE (CDR U) V))) 
	(T (CONS (CAR V) (MERGE U (CDR V))))))
;;;merge1 and sort3 are iterative (prog) versions of merge and sort1

(DEFUN MERGE1 (U V)
  (PROG (UU VV W X)
    (SETQ UU U VV V W NIL)
   A
    (COND ((NULL UU) (SETQ X VV) (GO E)))
    (COND ((NULL VV) (SETQ X UU) (GO E)))
    (COND ((LESSP (CAR UU) (CAR VV))     ;;;stack the smaller of first elements
	    (SETQ W (CONS (CAR UU) W))   ;;;onto w
	    (SETQ UU (CDR UU))
	    (GO A) ))
    (SETQ W (CONS (CAR VV) W))
    (SETQ VV (CDR VV))
    (GO A)
   E
    (COND ((NULL W) (RETURN X)))     ;;;unstack w onto what remains of uu or vv
    (SETQ X (CONS (CAR W) X))
    (SETQ W (CDR W))
    (GO E) ))


(DEFUN SORT3 (U1)
  (PROG (U V X M)
    (SETQ U U1 V NIL)
  SORTA
    (COND ((NULL U) (SETQ X NIL) (GO SORTC)))
    (SETQ M 0 X (LIST (CAR U)) U (CDR U))    ;;;m counts how deep into v we go 
  SORTB		;;;merge elements of v into x until empty slot found
    (COND ((NULL V) (SETQ V (LIST X)) (GO SORTB1)))
    (COND ((NULL (CAR V)) (SETQ V (CONS X (CDR V))) (GO SORTB1)))
    (SETQ X (MERGE1 X (CAR V)) M (ADD1 M) V (CDR V))
    (GO SORTB)
  SORTB1   ;;; tack on m NILs
    (COND ((EQ M 0) (GO SORTA)))
    (SETQ V (CONS NIL V) M (SUB1 M))
    (GO SORTB1)
  SORTC	;;; combine v into the list x	
    (COND ((NULL V) (RETURN X)))
    (SETQ X (MERGE1 X (CAR V)) V (CDR V))
    (GO SORTC)))